
(defmacro ora (&rest args)
    (or-expand args))

(defun or-expand (args)
    if (null args)
        nil
        (let ((sym (gensym)))
            `(let ((,sym ,(car args)))
                (if ,sym
                    ,sym
                    ,(or-expand (cdr args)))))))

(defmacro orb (&rest args)
    (if (null args)
        nil
        (let ((sym (gensym)))
            `(let ((,sym ,(car args)))
                (if ,sym
                    ,sym
                    (orb ,@(cdr args)))))))

(defmacro when-bind* (binds &body body)
    (if (null binds)
        `(progn ,@body)
        `(let (,(car binds))
            (if ,(caar binds)
                (when-bind* ,(cdr binds) ,@body)))))

(defmacro with-gensyms (syms &body body)
    `(let ,(mapcar #'(lambda (s)
                        `(,s (gensym)))
                     syms)
        ,@body))

(defmacro _f (op place &rest args)
    (multiple-value-bind (vars forms var set access)
                         (get-setf-method place)
        `(let* (,@(mapcar #' list vars forms)
               (,(car var) (,op ,access ,@args)))
        ,set)))

(defmacro fn (expr) `#' ,(rbuild expr))

(defun rbuild (expr)
    (if (or (atom expr) (eq (car expr) 'lambda))
        expr
        (if (eq (car expr) 'compose)
            (build-compose (cdr expr))
            (build-call (car expr) (cdr expr)))))

(defun build-call (op fns)
    (let ((g (gensym)))
        `(lambda (,g)
            (,op ,@(mapcar #'(lambda (f)
                            `(,(rbuild f) ,g))
                            fns)))))

(defun build-compose (fns)
    (let ((g (gensym)))
        `(lambda (,g)
            ,(labels ((rec (fns)
                        (if fns
                            `(,(rbuild (car fns))
                              ,(rec (cdr fns)))
                            g)))
            (rec fns)))))

(defconstant unforced (gensym))

(defstruct delay forced closure)

(defmacro delay (expr)
    (let ((self (gensym)))
        `(let ((,self (make-delay :forced unforced)))
            (setf (delay-closure ,self)
                #'(lambda()
                    (setf (delay-forced ,self) ,expr)))
            ,self)))

(defun force(x)
    (if (delay-p x)
        (if (eq (delay-forced x) unforced)
            (funcall (delay-closure x))
            (delay-forced x))
        x))

(defun make-db (&optional (size 1000))
    (make-hash-table :size size))

(defvar *default-db* (make-db))

(defun clear-db (&optional (db *default-db*))
    (clrhash db))

(defmacro db-query (key &optional (db '*default-db*))
    `(gethash ,key ,db))

(defun db-push (key val &optional (db *default-db*))
    (push val (db-query key db)))

(defmacro fact (pred &rest args)
    `(progn (db-push ',pred ',args)
        ',args))

(define (two-numbers)
    (list (choose '(0 1 2 3 4 5))
          (choose '(0 1 2 3 4 5))))

(define (parlor-trick sum)
    (let ((nums (two-numbers)))
        (if (= (apply + nums) sum)
            `(the sum of ,@nums)
            (fail))))

(defparameter *path* nil)
(defconstant failsym '@)

(defmacro choose (&rest choices)
    (if choices
        `(progn
            ,@(mapcar #'(lambda (c)
                            `(push #'(lambda () ,c) *paths*))
                      (reverse (cdr choices)))
            ,(car choices))
        '(fail)))

(defun fail ()
    (if *paths*
        (funcall (pop *paths*))
        failsym))


(defparameter *my-special-variable* 17)

(defun show-my-special ()
    (declare (special *my-special-variable*))
    (print *my-special-variable*) nil)

(defun do-something-else ()
    (show-my-special))

(defun dynamically-shadow-my-special ()
    (let ((*my-special-variable* 8))
         (do-something-else))
    (show-my-special))


(defparameter *list* nil)

(let ( (password nil)
       (secret nil) )
    (defun set-password (new-passwd)
        (if password
            ’|Can’t - already set|
            (setq password new-passwd)))

    (defun change-password (old-passwd new-passwd)
        (if (eq old-passwd password)
             (setq password new-passwd)
             ’|Not changed|))

    (defun set-secret (passwd new-secret)
        (if (eq passwd password)
            (setq secret new-secret)
            ’|Wrong password|))

    (defun get-secret (passwd)
        (if (eq passwd password)
            secret
            ’|Sorry|)))

(defun make-secret-keeper ()
    (let ( (password nil)
           (secret nil) )
        #’(lambda (operation &rest arguments)
            (ecase operation
                (set-password
                    (let ( (new-passwd (first arguments)) )
                        (if password
                            ’|Can’t - already set|
                            (setq password new-passwd))))

                (change-password
                    (let ( (old-passwd (first arguments) )
                           (new-passwd (second arguments)) )
                        (if (eq old-passwd password)
                            (setq password new-passwd)
                            ’|Not changed|)))

                (set-secret
                    (let ( (passwd (first arguments))
                           (new-secret (second arguments)) )
                        (if (eq passwd password)
                            (setq secret new-secret)
                            ’|Wrong password|)))

                (get-secret
                    (let ((passwd (first arguments)))
                        (if (eq passwd password)
                            secret
                            ’|Sorry|)))))))
